home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0174_Vector Ball Ellipse Splash.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  3KB  |  85 lines
  1. {
  2. {Places a large vector ball ellipse on the screen and makes it bounce
  3.  to pieces= nice visual effect}
  4. uses crt;
  5. const Balls = 1400;
  6.       startcolor=50;
  7. type movement= record
  8.      x,   y : integer;  { position }
  9.     dx,  dy : integer;  { velocity }
  10.    ddx, ddy : integer;  { acceleration }
  11.    color    : integer;
  12.    MaxYValue: integer;
  13.         END;
  14. VAR ch : char;
  15.     I,
  16.     Pull  : integer;
  17.     Dummy : string;
  18.     Ball  : array[1..BAlls] of movement;
  19. procedure PutDot(x,y,color:integer);
  20.   begin
  21.     Mem[$a000{VGA_Segment}:(y*320)+x] := color;
  22.   end;
  23. Procedure VideoMode ( Mode : Byte );
  24.     Begin { VideoMode }
  25.       Asm
  26.         Mov  AH,00
  27.         Mov  AL,Mode
  28.         Int  10h
  29.       End;
  30.     End;  { VideoMode }
  31. Procedure SetColors ( Color, Red, Green, Blue : Byte );
  32.     Begin { SetColor }
  33.       Port[$3C8] := Color;
  34.       Port[$3C9] := Red;
  35.       Port[$3C9] := Green;
  36.       Port[$3C9] := Blue;
  37.     End;  { SetColor }
  38. BEGIN {MAIN}
  39. videoMODE($13);
  40. for I:=1 to 250 do setcolors(I,i mod 50,
  41.                              i mod 50-20,
  42.                              I div ((i div 63)+1));
  43. fillchar(mem[$A000:(191*320)],320*8,Ord(StartColor));{line at bottom}
  44. FOR I:=1 to BAlls do BEGIN {INIT the balls into the array}
  45. WITH ball[i] do BEGIN
  46.   ddx  := 0;
  47.   ddy  := 1;             {constant pull downward}
  48.   dx   := Random(5)-2;   { start it moving left or right }
  49.   if dx=0 then dx:=1;    { not still}
  50.   dy   := 0;             { the object is initially at rest }
  51.   x    := trunc(cos(i)*140)+140+((i div ((i div 4)+1))*6);
  52.   y    := trunc(Sin(I+((i div ((I div 4)+1))))*70)+60+
  53.           ((i div ((I div 4)+1)*12)); {   you specified }
  54.   color:=Random( I div ((I div 254)+1)) + 1;  {Each Balls color}
  55.   MaxYValue:=Y;
  56. END; {with}
  57. END; {for do loop}
  58. Pull:=0; {init the gravity degrading effect}
  59. WHILE not(keypressed) do begin
  60.  FOR I:=1 to Balls do BEGIN
  61.   With ball[I] do BEGIN
  62.   putdot(x, y, 0);    { blank out the pixel drawn on the last iteration }
  63.   dx := dx + ddx;     { updating velocity }
  64.   dy := dy + ddy;
  65.   x  :=  x +  dx;     { updating position }
  66.   y  :=  y +  dy;
  67.   IF x< 1 then begin      {hits left of screen}
  68.      X  := 1;
  69.      dx := dx*-1;
  70.   End;
  71.   IF x > 319 then begin   {hits right of screen}
  72.      x  := 319;
  73.      dx := -dx;
  74.   END;
  75.   IF y > 190 then begin   { BOUNCE! }
  76.      y  := 190-(y-190)+1;
  77.      dy := -dy+pull;
  78.   End;
  79.   putdot(x, y, color);  { draw the pixel at the new position }
  80.   END; {WITH}
  81.  END; {for do loop}
  82. END; {KEYPRESS}
  83. VideoMODE($3);
  84. END. {PROGRAM}
  85.